Análisis de Datos I
Tarea 6

Librerías

library(FactoMineR)
library(factoextra)

Ejercicio 1

La siguiente tabla representa el tipo de estudios cursados (universitarios, cursos preparatorios, otros) según el tipo bachillerato cursado (A-Literatura, B-Economía, C-Ciencias (matemáticas, física), D-Ciencias naturales (biología, química,…).

Primero se confecciona la tabla a partir de los datos suministrados en el documento de la tarea 6:

T_contingencia <- matrix(c(13,2,5,20,20,2,8,30,10,5,5,20,7,1,22,30,50,10,40,100), byrow = T, nrow = 5, ncol = 4, 
            dimnames = list(c("A", "B", "C", "D","Total"), c("Univ.", "Prepa.", "Otros","Total")))
T_contingencia
##       Univ. Prepa. Otros Total
## A        13      2     5    20
## B        20      2     8    30
## C        10      5     5    20
## D         7      1    22    30
## Total    50     10    40   100

Ahora se crea la tabla de frecuencias:

T_frec_relativas <- T_contingencia/100 
dimnames(T_frec_relativas) <- list(c("A", "B", "C", "D","frec. r columna"), 
                                c("Univ.", "Prepa.", "Otros","frec. r fila"))
T_frec_relativas
##                 Univ. Prepa. Otros frec. r fila
## A                0.13   0.02  0.05          0.2
## B                0.20   0.02  0.08          0.3
## C                0.10   0.05  0.05          0.2
## D                0.07   0.01  0.22          0.3
## frec. r columna  0.50   0.10  0.40          1.0

a) Encuentre la tabla de efectivos teorica suponiendo independencia.

Para esto, primero calculamos la tabla de Frecuencias Teóricas considerando que el elemento en la fila \(i\), columna \(j\), corresponde al calculo de:

\[f_{i \bullet} \cdot f_{\bullet j}\]

Entonces:

generar_tabla_efectivos <- function(tabla){
  resultado <- tabla
  
  n_fil <- nrow(tabla)
  n_col <- ncol(tabla)
    
  for(i in 1:(n_fil - 1)){
    for(j in 1:(n_col - 1)){
      resultado[i,j] <- tabla[i,n_col]*tabla[n_fil,j]
    }
  }
  
  return(resultado)
}

T_frec_teoricas <- generar_tabla_efectivos(T_frec_relativas)
T_frec_teoricas
##                 Univ. Prepa. Otros frec. r fila
## A                0.10   0.02  0.08          0.2
## B                0.15   0.03  0.12          0.3
## C                0.10   0.02  0.08          0.2
## D                0.15   0.03  0.12          0.3
## frec. r columna  0.50   0.10  0.40          1.0

Finalmente, multiplicando por el total de individuos la matriz anterior, obtenemos la tabla de efectivos teóricos.

T_efec_teoricos <- 100*T_frec_teoricas
T_efec_teoricos
##                 Univ. Prepa. Otros frec. r fila
## A                  10      2     8           20
## B                  15      3    12           30
## C                  10      2     8           20
## D                  15      3    12           30
## frec. r columna    50     10    40          100

b) Calcular la distancia de \(\chi^{2}\) entre la tabla de contingencia real y la tabla de efectivos teorica en caso de independencia.

Para este calculo se recurre a la formula:

\[\chi^{2} = n\sum_{i=1}^{m_{1}} \sum_{j=1}^{m_{2}} \dfrac{(f_{ij} - f_{i \bullet} f_{\bullet j})^{2}}{f_{i \bullet} f_{\bullet j}}\]

calcular_distancia <- function(tabla){
  resultado <- 0
  
  n_fil <- nrow(tabla)
  n_col <- ncol(tabla)
    
  for(i in 1:(n_fil - 1)){
    for(j in 1:(n_col - 1)){
      aux <- tabla[i,n_col]*tabla[n_fil,j]
      resultado <- resultado + ((tabla[i,j] - aux)**2)/aux
    }
  }
  
  resultado <- 100*resultado
  
  return(resultado)  
}

distancia_chi <- calcular_distancia(T_frec_relativas)
distancia_chi
## [1] 24.91667

c) Calcule la matriz X de perfiles de fila y la matriz Y de perfiles de columna.

Para esto, se crearán dos funciones que calcules las matrices \(X\) e \(Y\).

perfiles_fila <- function(tabla){
  resultado <- tabla
  
  n_fil <- nrow(tabla)
  n_col <- ncol(tabla)
    
  for(i in 1:(n_fil - 1)){
    for(j in 1:(n_col - 1)){
      resultado[i,j] <- resultado[i,j]/tabla[i,n_col]
    }
  }
  
  return(resultado)
}

perfiles_columna <- function(tabla){
  resultado <- tabla
  
  n_fil <- nrow(tabla)
  n_col <- ncol(tabla)
    
  for(i in 1:(n_fil - 1)){
    for(j in 1:(n_col - 1)){
      resultado[i,j] <- resultado[i,j]/tabla[n_fil,j]
    }
  }
  
  return(resultado)
}

X <- perfiles_fila(T_frec_relativas)
Y <- perfiles_columna(T_frec_relativas)

X
##                     Univ.     Prepa.     Otros frec. r fila
## A               0.6500000 0.10000000 0.2500000          0.2
## B               0.6666667 0.06666667 0.2666667          0.3
## C               0.5000000 0.25000000 0.2500000          0.2
## D               0.2333333 0.03333333 0.7333333          0.3
## frec. r columna 0.5000000 0.10000000 0.4000000          1.0
Y
##                 Univ. Prepa. Otros frec. r fila
## A                0.26    0.2 0.125          0.2
## B                0.40    0.2 0.200          0.3
## C                0.20    0.5 0.125          0.2
## D                0.14    0.1 0.550          0.3
## frec. r columna  0.50    0.1 0.400          1.0

Ejercicio 2

Complete todas las demostraciones que quedaron pendientes en la presentación de la clase.

Ejercicio 3

3. El código abajo ilustra como construir una Tabla Cruzada en R a partir de una tabla Individuos × Variables. Explique en detalle cada línea del siguiente código y luego con la tabla resultante ejecute un AFC e interprete los resultados:

Se carga la librería MASS, la cual se utiliza para estimar modelos lineales generalizados mixtos por medio de métodos de cuasi-verosimilitud penalizados (PQL).

library(MASS)

La función head() retorna la primera parte del dataframe Cars93.

head(Cars93)
##   Manufacturer   Model    Type Min.Price Price Max.Price MPG.city MPG.highway
## 1        Acura Integra   Small      12.9  15.9      18.8       25          31
## 2        Acura  Legend Midsize      29.2  33.9      38.7       18          25
## 3         Audi      90 Compact      25.9  29.1      32.3       20          26
## 4         Audi     100 Midsize      30.8  37.7      44.6       19          26
## 5          BMW    535i Midsize      23.7  30.0      36.2       22          30
## 6        Buick Century Midsize      14.2  15.7      17.3       22          31
##              AirBags DriveTrain Cylinders EngineSize Horsepower  RPM
## 1               None      Front         4        1.8        140 6300
## 2 Driver & Passenger      Front         6        3.2        200 5500
## 3        Driver only      Front         6        2.8        172 5500
## 4 Driver & Passenger      Front         6        2.8        172 5500
## 5        Driver only       Rear         4        3.5        208 5700
## 6        Driver only      Front         4        2.2        110 5200
##   Rev.per.mile Man.trans.avail Fuel.tank.capacity Passengers Length Wheelbase
## 1         2890             Yes               13.2          5    177       102
## 2         2335             Yes               18.0          5    195       115
## 3         2280             Yes               16.9          5    180       102
## 4         2535             Yes               21.1          6    193       106
## 5         2545             Yes               21.1          4    186       109
## 6         2565              No               16.4          6    189       105
##   Width Turn.circle Rear.seat.room Luggage.room Weight  Origin          Make
## 1    68          37           26.5           11   2705 non-USA Acura Integra
## 2    71          38           30.0           15   3560 non-USA  Acura Legend
## 3    67          37           28.0           14   3375 non-USA       Audi 90
## 4    70          37           31.0           17   3405 non-USA      Audi 100
## 5    69          39           27.0           13   3640 non-USA      BMW 535i
## 6    69          41           28.0           16   2880     USA Buick Century

La función table() utiliza factores de clasificación cruzada para crear una tabla de contingecia. En este caso las columnas Type y DriveTrain son las que deben ser utilizadas como factores para la creación de la tabla cruzada. El resultado se guarda en la variable datos.

datos <- table(Cars93$Type, Cars93$DriveTrain)

Se imprime la variable datos, la cual muestra la frecuencia de ocurrencia de cada combinación posible de valores entre las variables Type y DriveTrain.

datos
##          
##           4WD Front Rear
##   Compact   1    13    2
##   Large     0     7    4
##   Midsize   0    17    5
##   Small     2    19    0
##   Sporty    2     7    5
##   Van       5     4    0

La función class() obtiene qué clase posee el objeto datos. En este caso es de tipo table.

class(datos)
## [1] "table"

La función unclass() se encarga de convertir el objeto datos que era de tipo table en una lista sin ninguna clase específica.

datos <- unclass(datos)

Se obtiene la clase del objeto datos. En este caso puede ser matrix o array.

class(datos)
## [1] "matrix" "array"

Con la función as.data.frame() se convierte el objeto datos en uno de tipo data.frame

datos <- as.data.frame(datos)

Se obtiene la clase del objeto datos. En este caso data.frame debido a la función aplicada anteriormente.

class(datos)
## [1] "data.frame"

Se imprime la variable datos.

datos
##         4WD Front Rear
## Compact   1    13    2
## Large     0     7    4
## Midsize   0    17    5
## Small     2    19    0
## Sporty    2     7    5
## Van       5     4    0

Ahora vamos a ejecutar un AFC con la tabla cruzada resultante.

AFC_datos <- CA(datos, graph = F)
AFC_datos
## **Results of the Correspondence Analysis (CA)**
## The row variable has  6  categories; the column variable has 3 categories
## The chi square of independence between the two variables is equal to 35.00129 (p-value =  0.0001248018 ).
## *The results are available in the following objects:
## 
##    name              description                   
## 1  "$eig"            "eigenvalues"                 
## 2  "$col"            "results for the columns"     
## 3  "$col$coord"      "coord. for the columns"      
## 4  "$col$cos2"       "cos2 for the columns"        
## 5  "$col$contrib"    "contributions of the columns"
## 6  "$row"            "results for the rows"        
## 7  "$row$coord"      "coord. for the rows"         
## 8  "$row$cos2"       "cos2 for the rows"           
## 9  "$row$contrib"    "contributions of the rows"   
## 10 "$call"           "summary called parameters"   
## 11 "$call$marge.col" "weights of the columns"      
## 12 "$call$marge.row" "weights of the rows"

Porcentaje de varianza explicada

fviz_screeplot(AFC_datos, addlabels = TRUE)

Como se puede observar el mayor porecentaje de varianza explicada como es de esperase viene dado por la dimensión 1. En total si se toman en cuenta las dos dimensiones se tiene un porcentaje de varianza explicada del 100%.

Biplot

fviz_ca_biplot(AFC_datos, repel = TRUE)

Analizando el gráfico de individuos y variables se puede notar que los automóviles que poseen tracción delantera son los pequeños, compactos y medianos. Los de tracción trasera son los deportivos y grandes. Por último, los vehículos que poseen doble tracción son las camionetas.

Cosenos cuadrados para filas

fviz_cos2(AFC_datos, choice = "row", axes = 1:2)

Cosenos cuadrados para columnas

fviz_cos2(AFC_datos, choice = "col", axes = 1:2)

Tanto en el gráfico de cosenos cuadrados de filas como de columnas todos los individios y variables están completamente bien representados ya que su coseno cuadrado es igual a 1.

Contribuciones para las filas

fviz_ca_row(AFC_datos, col.row = "contrib", 
            gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), 
            repel = TRUE)

Para las filas se tiene que el individuo con mayor contribución es el vehículo de tipo camioneta y el de menor de tipo compacto, los demás poseen contribuciones similares.

Contribuciones para las columnas

fviz_ca_col(AFC_datos, col.col = "contrib",
            gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
            repel = TRUE)

En el lado de las variables la que posee mayor contribución es la de doble tracción, seguidamente tracción trasera y por último, la tracción delantera.